home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / FILLSURF.INC < prev    next >
Text File  |  1991-09-25  |  4KB  |  110 lines
  1. procedure BADSURF;
  2.  
  3. { A bad surface was attempted to be plotted. Explain why and halt. }
  4. begin
  5.   exgraphic;
  6.   writeln ('Error: You have attempted to plot a concave surface.');
  7.   writeln ('  This surface should be broken into at least two smaller');
  8.   writeln ('  surfaces. Alternatively, you may possibly be able to');
  9.   writeln ('  plot this surface anyway from a different angle or');
  10.   writeln ('  with a lower magnification factor.');
  11.   halt;
  12. end;  { procedure BADSURF }
  13.  
  14.  
  15. procedure FILLSURF (Surf: word; Mat: integer; Oldshade: real);
  16.  
  17. { Draw a filled surface number Surf }
  18.  
  19. var Npts: integer;               { #points on edges of the surface }
  20.     Nextpt: integer;             { Next point to use for filling }
  21.     Node1, Node2: word;          { node numbers of endpts of line }
  22.     Xpt, Ypt: points;            { pts on edges of surface }
  23.     Vert: integer;               { vertex number }
  24.     Pcolor: integer;             { actual color to plot with }
  25.     Fmod: integer;               { mod for filling function }
  26.     Ishade: integer;             { int version of shade (0..16) }
  27.     Color1, Color2: integer;     { color #'s to use for dithering }
  28.     Shade: real;                 { shade interpolated between palette entries }
  29.     Col: integer;                { color # (temp) }
  30.  
  31. begin
  32. {$ifdef BIGMEM}
  33. with ptrd^ do with ptre^ do with ptrh^ do with ptri^ do
  34. begin
  35. {$endif}
  36.   Shade := Oldshade;
  37.   if (onscreen (Surf)) then begin
  38.  
  39.     if Mat = 0 then
  40.       { Used in hidden line plots only }
  41.       Col := 0
  42.     else
  43.       Col := Color[Mat];
  44.     if (Ncolors >= 3) and (Mono) then
  45.       { use system's colors as shades of grey }
  46.       colormod (Shade, GrSys, Col, Pcolor, Fmod)
  47.     else begin
  48.       { use dithered shading }
  49.       findcolors (Mat, Col, Shade, Color1, Color2);
  50.       Ishade := trunc (Shade * 16.0); { only 16 dither levels }
  51.     end;
  52.  
  53.     Npts := 0;
  54.     for Vert := 1 to Nvert[Surf]-1 do begin
  55.       Node1 := Konnec (Surf, Vert);
  56.       Node2 := Konnec (Surf, Vert+1);
  57.       storline (round(Xtran[Node1]), round(Ytran[Node1]),
  58.                 round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
  59.       if (Npts < 0) then
  60.         badsurf;
  61.     end; { for Vert }
  62.  
  63. { One last line to close the polygon }
  64.     Node1 := Konnec (Surf, Nvert[Surf]);                    { last node }
  65.     Node2 := Konnec (Surf, 1);                          { first node }
  66.     storline (round(Xtran[Node1]), round(Ytran[Node1]),
  67.               round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
  68.     if (Npts < 0) then
  69.       badsurf;
  70.  
  71. { Sort the line segment points, first by Y, then by X }
  72.     shellpts (Xpt, Ypt, Npts);
  73.  
  74. { Now draw the filled surface }
  75.     Nextpt := 1;
  76.     if (Ncolors >= 3) and (Mono) then begin
  77.       { use system's colors as shades of grey }
  78.       while (Nextpt < Npts) do begin
  79.         if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
  80.            (Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
  81.           shdraw (Xpt[Nextpt],Xpt[Nextpt+1],Ypt[Nextpt],Pcolor,Fmod);
  82.           Nextpt := Nextpt + 2;
  83.         end else begin
  84.           shplot (Xpt[Nextpt], Ypt[Nextpt], Pcolor, Fmod);
  85.           Nextpt := Nextpt + 1;
  86.         end;
  87.       end; { while }
  88.       if (Nextpt = Npts) then
  89.         shplot (Xpt[Nextpt], Ypt[Nextpt], Pcolor, Fmod);
  90.     end else begin
  91.       { use dithered shading }
  92.       while (Nextpt < Npts) do begin
  93.         if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
  94.            (Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
  95.           dithdraw (Xpt[Nextpt],Xpt[Nextpt+1],Ypt[Nextpt],Ishade,Color1,Color2);
  96.           Nextpt := Nextpt + 2
  97.         end else begin
  98.           dithplot (Xpt[Nextpt],Ypt[Nextpt],Ishade,Color1,Color2);
  99.           Nextpt := Nextpt + 1
  100.         end;
  101.       end; { while }
  102.       if (Nextpt = Npts) then
  103.         dithplot (Xpt[Nextpt],Ypt[Nextpt],Ishade,Color1,Color2);
  104.     end; { if Ncolors... }
  105.   end; { if onscreen }
  106. {$ifdef BIGMEM}
  107. end; {with}
  108. {$endif}
  109. end; { procedure FILLSURF }
  110.